The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor1/bjck.src

Text File | 1990-10-09 | 12KB | 305 lines

%%HP: T(3)A(R)F(.);
@ by Ron Dippold; see shareware notice in "ABOUT" routine.
DIR
  ABOUT
    \<< # 83h # 40h PDIM MBB PICT STO
      PICT { # 0h # 39h } # 83h # 7h BLANK REPL
      57 "(C)1990 Ron Dippold" 2 AB2
      PICT { # 12h # 4h } # 5Fh # 31h BLANK REPL
      { # 13h # 5h } { # 6Fh # 33h } BOX
      7 "48 Blackjack V1" 2 AB2
      15 "- THIS IS SHAREWARE -" 1 AB2
      21 "IF YOU KEEP THIS YOU" 1 AB2
      27 "MUST SEND $5 TO" 1 AB2
      33 "- RON DIPPOLD JR. -" 1 AB2
      39 "8318 COUNTERPANE LN" 1 AB2
      45 "JUNEAU, AK 99801" 1 AB2
      { # 0h # 0h } PVIEW 0 WAIT DROP PLAY
    \>>
  PLAY
    \<< RCLF 'FLGS' STO -40 CF # 83h # 40h PDIM { # 0h # 0h } PVIEW 50
      'BET' STO 1 SF
      IF NC
      THEN 1 CF
      END 1000 'M' STO
      DO 1
        IF FS?
        THEN SHUFL
        END BJH
      UNTIL 2 FS?
      END
    \>>
  DC
    \<< OBJ\-> DROP \-> l c s
      \<< PICT l
        IF s
        THEN EC { # 2h # 2h } c 2 \->GROB REPL { # 8h # 12h } c 2 \->GROB
        REPL { # 4h # Ah } 'SUIT(s)' EVAL REPL
        ELSE BC
        END
        IF 2 FS?
        THEN { # 0h # 0h } { # 7h # 1Ah } SUB
        END REPL
      \>>
    \>>
  DEAL
    \<<
      IF 1 FC?
      THEN
        IF NC
        THEN \-> P
          \<< 'CDS(NC )' EVAL -1 'NC' STO+ DUP 'PC(P)' EVAL 8 * R\->B P 1 -
            29 * R\->B 2 \->LIST OVER 3
            IF FS?
            THEN DROP { "" 0 }
            END 2 CF DC 'PC(P)' EVAL 1 + 'PC(P)' STO 1 \->LIST 'PT(P)' EVAL
          SWAP + 'PT(P)' STO DROP
          \>>
        ELSE 1 SF DROP
        END
      END
    \>>
  BLNK
    \<< PICT { # 0h # 39h } # 83h # 7h BLANK REPL MSG .5 WAIT PICT RCL SWAP 1 3
      START DUP PICT { # 0h # 0h } ROT REPL .5 WAIT SWAP
      NEXT DROP2
    \>>
  MSG
    \<< 2 \->GROB DUP
      SIZE \-> X Y
      \<< MPIC { # 0h # 0h } X 6 + Y 6 + 2 \->LIST SUB
        SWAP { # 4h # 4h } SWAP GXOR
        MPIC2 { # 0h # 0h } X 4 + Y 5 + 2 \->LIST SUB
        X 3 + Y 3 + BLANK { # 1h # 1h }
        SWAP REPL { # 1h # 1h } SWAP GXOR
        PICT RCL SWAP PICT SWAP
        127 X - 2 / 53 Y - 2 / 2 \->LIST SWAP REPL
      \>>
    \>>
  PT { { { "3" 1 } { "5" 4 } } { { "4" 4 } { "8" 1 } { "T" 3 } } }
  PC { 2 3 }
  SCOR
    \<< 5 CF PT SWAP GET OBJ\-> 0 SWAP 1 SWAP
      START SWAP OBJ\-> DROP2 "A23456789T" SWAP POS
        IF DUP NOT
        THEN DROP 10
        END
        IF DUP 1 ==
        THEN 5 SF
        END +
      NEXT
    \>>
  AB2
    \<< \->GROB DUP SIZE DROP 133 SWAP - 2 / ROT R\->B 2 \->LIST SWAP PICT 3
      ROLLD REPL
    \>>
  SHOWC
    \<< \-> P
      \<< # 0h P 1 - 29 * R\->B 2 \->LIST ' PT(P)' EVAL 1 GET 2 SF DC 2 CF
      \>>
    \>>
  MBB
GROB 131 64 00007555555555555555BAAD46440810000000755555555555555532A906E40855501000755555555555555537A9E6040855501000755555555555555530A11E040855503000FFFF75555555555530A1FF040855501000FFFFF5555555555530A91C040855501000300087555555555530A61074085550000030000000000000000000009708555000003000FFFFFFFFFFFFFFFF99040855500000300010000000000000009406085550000030009AB2829A30C300005306085550000030009AA28AAA80A0000097070855500000300019A28BBA30C1000097C60855500000F81019A28A2980820000DF3E0855500000FD3019B38A2930E1000094070855500000FF701000000000000000D4C70855501000FF70FFFFFFFFFFFFFFFF5FF708FF701000FF70000000000000000045E708FF703000FF700655DF555F75306EBAC50810001000FF30065DFFAAAE7530AB7B840810001000F100000000000000000000000810000000BDFFFFFFFFFFFFFFFFFFFFF70810000000350000000000000000000004081000000034E1300000022000008700140810000000342220000002200000880014E810000000342220000002200000880014481000000034222C1FC104172AE088C934593000000034E120A02208882A10872214FB7000000034202CB0E308882A0088E314FB70000000342022A02008882A00882014FB70000020342022A02008882A00882054F930000070F4207C3FC10807CB0087C124F9100018F0F50000000000000000000004E8F0001CF1FDFFFFFFFFFFFFFFFFFFFFF748F10038F0F1000000000000000000000008F3001070FF700EBAFBAAAAF5302F5495E8F3001020FF700E75F7555DF5302FDF9519F3000000FF300EFA60000000002E451419F1000000FF100E755FFFFFFF7024EF3419F0000831BF000EFA2100000040EFFFF71810000441370006F551200000400000001810000441320006FB21200000400000001810000441300006F751F00000400000001830000441300006DF292000004000000C7810000441300006DF717000004000000008100004413000065F71A00000400000000C100004413000065F79700000400000000F100008313000065D712000004FFFFFFFFF0000000030000655512000004FFFFFFFF3000000003200065551000000455555530000000000370006555FFFFFFF755555530000000000BF00065550000000055555530000000008FF10065555555555555555530C1000000EFF30065555555555555555530E3000FFFFFF70065555555555555555530F7000FFF3EF70065555555555555555530F70000000000000000000000000000000000000FFFFFFFFFF7FFFFFDFFFF7FFFFFDFFFF70FF5CFDF71F7F74CFDF11F7FFFFFD764C70FF5DFD775F7F77DFDBD5F7FFFFFD75FE70F85DFD365F7744DFD115F7FFFFFD76EE70FF5DFD775F7FF5DFDB75F7FFFFFD75FE70FF5CFDF71F7F74CFDF11F7FFFFFD76CE70FFFFFDFFFF7FFFFFDFFFF7FFFFFDFFFF70
  PLA2
    \<< PICT { # 0h # 39h } # 83h # 7h BLANK REPL 1 SHOWC 7 CF
      DO 1 SCOR DUP 17 \>= SWAP DUP 7 \>= 11 \<= AND 5 FS? AND OR
        IF
        THEN 7 SF WHO
        ELSE 1 DEAL 1 SCOR
          IF 21 >
          THEN "Dealer Busted!" BLNK WIN 7 SF
          END
        END
      UNTIL 7 FS?
      END
    \>>
  PLA
    \<<
      IF BJC
      THEN PICT { # 0h # 39h }
        IF 'PC(2)' EVAL 3 > BET 2 * M > OR
        THEN PBB 14 CF
        ELSE PBB2 14 SF
        END REPL { # 0h # 0h } PVIEW 9 CF
        DO 0 WAIT IP 15 CF
          IF DUP 13 == 14 FS? AND
          THEN DROP 11 15 SF
          END
          IF DUP 16 ==
          THEN DROP 9 SF PLA2
          ELSE
            IF DUP 11 ==
            THEN 2 DEAL
              IF 1 FS?
              THEN DROP 9 SF
              ELSE 2 SCOR 5 CF
                IF 21 \<=
                THEN DROP
                  IF 15 FS?
                  THEN 9 SF PLA2
                  END
                ELSE DROP "Busted!" BLNK LOSE 9 SF
                END
              END
            ELSE DROP
            END
          END
        UNTIL 9 FS?
        END
      END
    \>>
  WHO
    \<< 1 2
      FOR I I SCOR
        IF 5 FS?
        THEN
          IF DUP 12 <
          THEN 10 +
          END
        END DUP PICT 'PC(I)' EVAL 8 * 10 + R\->B I 29 * 19 - R\->B 2 \->LIST
      ROT 1 \->GROB REPL
      NEXT DUP2
      IF ==
      THEN DROP2 "Tie - Push" MSG DROP
      ELSE
        IF >
        THEN LOSE
        ELSE WIN
        END
      END
    \>>
  PBB2
GROB 131 7 FFFFFDFFFF7FFFFFDFFFF7FFFFFDFFFF70FBA8FDFFFF7F99DFDFFFF7FFFFF5444560FBADFDFFFF7F55DFDFFFF7FFFFF5F65450F3ADFDFFFF7F59DFDFFFF7FFFFF5C64450FBADFDFFFF7F55DFDFFFF7FFFFFDD65450FBADFDFFFF7F991FDFFFF7FFFFF5C65560FFFFFDFFFF7FFFFFDFFFF7FFFFFDFFFF70
  QUIT
    \<< PICT { # 0h # 39h } QPIC REPL
      DO 0 WAIT IP
        IF DUP 16 ==
        THEN DROP "You had $" M \->STR + BYE
        ELSE
          IF 11 ==
          THEN
            IF M NOT
            THEN "You have no money" BYE
              IF M 10000 \>=
              THEN "You broke the Bank!" BYE
              END
            END 1
          ELSE 0
          END
        END
      UNTIL
      END
    \>>
  BJC
    \<< 8 CF 1 SCOR
      IF 11 == 5 FS?C AND
      THEN 8 SF
      END 2 SCOR
      IF 11 == 5 FS?C AND
      THEN
        IF 8 FS?
        THEN 1 SHOWC "Double Blackjack" BLNK 0
        ELSE 1 SHOWC "Your Blackjack" BLNK 11 SF WIN 0
        END
      ELSE
        IF 8 FS?
        THEN 1 SHOWC "Dealer Blackjack" BLNK LOSE 0
        ELSE 1
        END
      END
    \>>
  BYE
    \<< FLGS STOF MSG PICT { # 0h # 39h } # 83h # 7h BLANK REPL CLEAR 0 WAIT
      DROP ERASE TEXT KILL
    \>>
  MPIC2
GROB 129 13 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF10
  QPIC
GROB 131 7 FFFFFDFFFF7FFFFFDFFFF7FFFFFDFFFF703A54DDFFFF7FFFFFDFFFF7FFFFFD765170BA65DDFFFF7FFFFFDFFFF7FFFFFDB55B70B27DEDFFFF7FFFFFDFFFF7FFFFFDB55B70BA6CEDFFFF7FFFFFDFFFF7FFFFFDB65B703A5DEDFFFF7FFFFFDFFFF7FFFFFD754B70FFFFFDFFFF7FFFFFDFFFF7FFFFFDFFFF70
  FLGS { # B800004200114FF2h # 2101h }
  WIN
    \<< "You Win" MSG DROP BET
      IF 11 FS?C
      THEN 1.5 *
      END
      IF 15 FS?C
      THEN 2 *
      END 'M' STO+
    \>>
  LOSE
    \<< "You Lose" MSG DROP BET
      IF 15 FS?C
      THEN 2 *
      END NEG 'M' STO+
      IF M BET <
      THEN M 'BET' STO
      END
    \>>
  MPIC
GROB 131 15 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70
  PBB
GROB 131 7 FFFFFDFFFF7FFFFFDFFFF7FFFFFDFFFF70FBA8FDFFFF7FFFFFDFFFF7FFFFF5444560FBADFDFFFF7FFFFFDFFFF7FFFFF5F65450F3ADFDFFFF7FFFFFDFFFF7FFFFF5C64450FBADFDFFFF7FFFFFDFFFF7FFFFFDD65450FBADFDFFFF7FFFFFDFFFF7FFFFF5C65560FFFFFDFFFF7FFFFFDFFFF7FFFFFDFFFF70
  PB2
    \<< { # 0h # 0h } PVIEW 0 WAIT IP
      IF DUP 16 ==
      THEN DROP 1
      ELSE
        IF DUP 15 <
        THEN 10 - MBA SWAP GET BET +
          IF DUP 10 <
          THEN DROP 10
          END
          IF DUP 500 >
          THEN DROP 500
          END
          IF DUP M >
          THEN DROP M
          END 'BET' STO 0
        ELSE DROP 0
        END
      END
    \>>
  PBET
    \<< PICT { # 0h # 0h } MBB REPL PICT { # 4Fh # Ah } M \->STR 1 \->GROB REPL
      DO PICT { # 37h # 28h } "$" BET \->STR +
        IF BET 100 <
        THEN " " +
        END 3 \->GROB REPL PB2
      UNTIL
      END ERASE
    \>>
  BJH
    \<< ERASE { 0 0 } 'PC' STO { { } { } } 'PT' STO PBET 2 DEAL 3 SF 1 DEAL 3
      CF 2 DEAL 1 DEAL 11 CF
      IF 1 FC?
      THEN PLA
        IF 1 FC?
        THEN QUIT
        END
      END
    \>>
  SHUFL
    \<< "Shuffling" MSG CDS OBJ\-> DROP 1 200
      START RAND 52 * CEIL ROLL RAND 52 * 1 + IP ROLLD
      NEXT 52 \->LIST 'CDS' STO 52 'NC' STO 1 CF PICT { # 0h # 0h } ROT REPL
    \>>
  BET 50
  MBA { -10 10 -50 50 }
  M 950
  NC 47
  CDS { { "Q" 1 } { "4" 2 } { "6" 2 } { "7" 4 } { "7" 2 } { "5" 1 } { "A" 3 }
{ "6" 4 } { "T" 4 } { "J" 2 } { "3" 3 } { "2" 4 } { "2" 2 } { "5" 3 } { "K" 3 }
{ "K" 4 } { "9" 1 } { "K" 1 } { "J" 1 } { "T" 1 } { "9" 2 } { "J" 3 } { "3" 4 }
{ "6" 3 } { "2" 3 } { "8" 3 } { "7" 3 } { "4" 3 } { "Q" 4 } { "A" 2 } { "9" 3 }
{ "A" 1 } { "A" 4 } { "7" 1 } { "K" 2 } { "5" 2 } { "T" 2 } { "Q" 3 } { "J" 4 }
{ "6" 1 } { "8" 4 } { "8" 2 } { "9" 4 } { "3" 2 } { "2" 1 } { "Q" 2 } { "4" 1 }
{ "T" 3 } { "5" 4 } { "8" 1 } { "3" 1 } { "4" 4 } }
  EC
GROB 15 27 EFF31004100410041004100410041004100410041004100410041004100410041004100410041004100410041004100410041004EFF3
  BC
GROB 15 27 FFF710049FF45555DAA55555DAA55555DAA55555DAA55555DAA55555DAA55555DAA55555DAA55555DAA55555DAA555559FF41004FFF7
  SUIT { GROB 7 7 22559414224180 GROB 7 7 80412214224180
         GROB 7 7 80C1A2F7A280C1 GROB 7 7 80C1E3F7F7C1E3 }
  PPAR { (-6.5,-3.1) (6.5,3.2) X 0 (0,0) FUNCTION Y }
END